Pascal Super Library/Pascal Super Library (CW International)(1997).bin/COMM/PPL4P10A/ZMODEM.PAS

Pascal/Delphi Source File | 1995-02-20 | 45KB | 1,956 lines

(*
**
**   --- please read this ! ---
**
**  This source code is in "shrouded" form. It is distributed in this form
**  rather than as a library (.LIB) file because of the inconsistancies
**  between object files generated by different compilers. To support several
**  compilers would require a .LIB file for each compiler manufacturer, and
**  sometimes several versions of the .LIB file are needed for the different
**  versions of the same manufacturers compiler!
**
**  You can compile this code, but you will have to register with us in order
**  to get the normal (commented) C source code with normal variable names.
*)







UNIT zmodem;

INTERFACE

USES Crt, Dos, zdate, crc16, crc32, PCL4P, hex_io, term_io, file_io;

function ZmodemTx(
         V70     : Integer;      { COM port }
     Var V40 : String;       { file spec buffer }
         V91   : Boolean)      { Can do streaming ? }
       : Boolean;

function ZmodemRx(
         V70     : Integer;      { COM port }
     Var V39 : String;       { filename buffer }
         V91   : Boolean)      { Can do streaming ? }
       : Boolean;

IMPLEMENTATION

Const
   Debug     = False;

   V117  = 1024;  {TX/RX buffer size}
   V114  =   32;  {Attn buffer string size}

   V95 =    2;
   V54  =    9;
   V68   =   18;
   V105  =   36;
   V96  =  182;

Type
   BufType  = BufferType;
   HdrType  = Array[0..3] of Byte;

Const
   V191  = 42;  { '*' }
   V133  = 24;  { ^X  }
   V134 = 88;
   V115  = 65;  { 'A' }
   V145  = 66;  { 'B' }
   V116 = 67; { 'C' }

   V194 = 0;
   V192  = 1;
   V197  = 2;
   V113    = 3;
   V142   = 4;
   V198   = 5;
   V185    = 6;
   V112  = 7;
   V143    = 8;
   V193   = 9;
   V132   = 10;
   V135    = 11;
   V141   = 12;
   V126    = 13;
   V121 = 14;
   V124   = 15;
   V119     = 16;
   V144 = 17;
   V123 = 18;
   V199  = 19;
   V127 = 104; { 'h' }
   V128 = 105; { 'i' }
   V129 = 106; { 'j' }
   V130 = 107; { 'k' }
   V195 = 108; { 'l' }
   V196 = 109; { 'm' }
   V186 = 0;
   V201 =  -1;
   V136   = -40;
   V72     = -41;
   V53    = 256;
   V49  = 360;
   V50  = 361;
   V51  = 362;
   V52  = 363;
   V48   = 272;

 Const
   V28 = 5;
   V10 = 24;
   V110 = 19;
   V111 = 17;
   V87 = 1;
   V93 = 2;
   V30 = 4;
   V1 = 6;
   V63 = 21;
   V18 = 26;
   V34 = 27;

{ byte positions }
Const
   V137 = 3;
   V138 = 2;
   V139 = 1;
   V140 = 0;
   V187 = 0;
   V188 = 1;
   V189 = 2;
   V190 = 3;

{ bit masks for V192 }
Const
   V15  =  1;    {handle full duplex  - YES}
   V17 =  2;    {overlay disk and serial I/O - YES}
   V11  =  4;    {send a break - YES}
   V13  =  8;    {encrypt/decrypt - NO}
   V16  = 16;    {LZW compress - NO}
   V14 = 32;    {use 32 bit CRCs - YES}
   V36  = 64;    {escapes all control chars - NO}
   V35    =128;    {escapes the 8th bit - NO}

{ bit masks for V197 }
Const
   V98 =  64;
   V97   = 128;

{ paramaters for V142 }
Const
{ V137 }
   V120 = 1;
   V122  = 2;
   V131 = 3;
{ V138 }
   V162 = 1;
   V149 = 2;
   V146 = 3;
   V148 = 4;
   V183 = 5;
   ZMDIfF = 6;
   V163 = 7;
{ V139 }
   V202 = 1;
   V200 = 2;
   V203 = 3;
{ V140 }
   V118 = 1;

Var
   { global variables }
   V71 : Integer;
   V4   : BufType;
   V85    : BufType;
   V107     : hdrType;
   V77     : hdrType;
   V78     : LongInt;
   V79 : Integer;
   V80    : Integer;
   V76 : Integer;
   V39  : String;
   V42  : LongInt;
   V38 : LongInt;
   V21 : Boolean;
   V108     : LongInt;
   V32: Word;
   V92 : Boolean;
Const
   V59: Byte = 0;
   V27   :  array[0..3] of char = 'EGQW';
   V26 :  String = 'ZCRCX: Pos=';

Procedure V24;
Begin
   WriteMsg('Disk I/O Error')
end;

Procedure V152(x:Char; n: Integer; V55:HdrType);
Var
   i      : Integer;
   Text : String;
Begin
   If (n > 20) Then n := 20;
   Text := x + ':';
   CASE n OF
     -42 : Text := Text + 'MESSED_UP';
     -41 : Text := Text + 'ZNOCARRIER';
     -40 : Text := Text + 'ZERROR';
     -1  : Text := Text + 'ZTIMEOUT';
   end;
   if Debug then CASE n OF
      0  : Text := Text + 'ZRQINIT';
      1  : Text := Text + 'ZRINIT';
      2  : Text := Text + 'ZSINIT';
      3  : Text := Text + 'ZACK';
      4  : Text := Text + 'ZFILE';
      5  : Text := Text + 'ZSKIP';
      6  : Text := Text + 'ZNAK';
      7  : Text := Text + 'ZABORT';
      8  : Text := Text + 'ZFIN';
      9  : Text := Text + 'ZRPOS';
      10 : Text := Text + 'ZDATA';
      11 : Text := Text + 'ZEOF';
      12 : Text := Text + 'ZFERR';
      13 : Text := Text + 'ZCRC';
      14 : Text := Text + 'ZCHALLENGE';
      15 : Text := Text + 'ZCOMPL';
      16 : Text := Text + 'ZCAN';
      17 : Text := Text + 'ZFREECNT';
      18 : Text := Text + 'ZCOMMAND';
      19 : Text := Text + 'ZSTDERR';
   Else
      Text := Text + 'ZUNKNOWN';
   End;
   if Length(Text) > 2 then WriteMsg(Text);
End;

Procedure V175(V99: Byte);
var
   i : Integer;
Begin
   {escape certain control chars}
   If ((V99 AND $7F) IN [16,17,19,24]) OR (((V99 AND $7F) = 13)
    AND ((V59 And $7F) = 64)) Then
      Begin
         i := SioPutc(V71,chr(V133));
         V59 := (V99 XOR 64)
      End
   Else V59 := V99;
   i := SioPutc(V71,chr(V59))
End;

Function V151 : LongInt;
Var
   V37 : BufType;
   V20     : LongInt;
   n       : Integer;
   V7   : Word;
Begin
   V20 := $FFFFFFFF;
   If not fioSeek(0) Then {null};
   Repeat

      if not fioRead(V37,V117,V7) then V24;

      For n := 0 To (V7 - 1) Do
         V20 := UpdateCrc32(V37[n],V20)
   Until (V7 < V117) OR (IOresult <> 0);
   If not fioSeek(0) Then ;
   V151 := V20
End;

Function V147 : Boolean;
Begin
  {V147 := SioDCD(V71)}
  V147 := True
end;

Function V155(V103: Integer): Integer;
{ Returns V72 if no carrier, or }
{ V201 if nothing received }
{ within 'Tics' tics (18.2 tics per second.}
Var
   i : Integer;
Begin
   Repeat
      If (NOT V147) Then
      Begin
         V155 := V72;
         Exit
      End;
      i :=  SioGetc(V71,1);
      If i >= 0 Then
         Begin
            V155 := i;
            Exit
         End;
      Dec(V103)
   Until (V103 <= 0);
   { timed out }
   V155 := V201
End;

Function V166: Integer;
{ Strips parity & ignores V111/V110 characters. }
Var
   c: Integer;
Begin
   Repeat
      c := V155(V79) And $FF7F   {strip parity }
   Until (c < 0) OR (NOT (Lo(c) IN [17,19])); {wait for other than V111/V110 }
   V166 := c
End;

Procedure V176;
{ Send a zmodem cancel sequence }
Var
   i, n: BYTE;
Begin
   i := SioTxFlush(V71);
   For n := 1 To 8 Do
      Begin
         i := SioPutc(V71,chr(V10));
         SioDelay(V95)
      End;
   For n := 1 To 10 Do i := SioPutc(V71,chr(8));
End;

Procedure zmPutString(Var p: BufType);
{ Outputs ASCIIZ string }
Var
   i, n: Integer;
Begin
   n := 0;
   While (n < V117) And (p[n] <> 0) Do
   Begin
      CASE p[n] OF
         221 : i := SioBrkSig(V71,ASSERT);
         222 : SioDelay(V105)
         Else i := SioPutc(V71,chr(p[n]))
      End;
      Inc(n)
   End
End;

Procedure zmPutHex(Byte: BYTE);
Const
   V56: ARRAY[0..15] OF CHAR = '0123456789abcdef';
Var
   i : Integer;
Begin
   i := SioPutc(V71,V56[Byte SHR 4]);
   i := SioPutc(V71,V56[Byte And $0F])
End;

Procedure V182(hType: BYTE; Var V55: hdrType);
{ Sends a hex header }
Var
   V20 : Word;
   n, i: Integer;
Begin
   V152('S',hType,V55); {mdm}
   i := SioPutc(V71,chr(V191));
   i := SioPutc(V71,chr(V191));
   i := SioPutc(V71,chr(V133));
   i := SioPutc(V71,chr(V145));
   zmPutHex(hType);
   V20 := UpdateCrc16(hType,0);
   For n := 0 To 3 Do
      Begin
         zmPutHex(V55[n]);
         V20 := UpdateCrc16(V55[n],V20)
      End;
   V20 := UpdateCrc16(0,V20);
   V20 := UpdateCrc16(0,V20);
   zmPutHex(Lo(V20 SHR 8));
   zmPutHex(Lo(V20));
   i := SioPutc(V71,chr(13));
   i := SioPutc(V71,chr(10));
   If (hType <> V143) And (hType <> V113) Then
      i := SioPutc(V71,chr(17));  {XON}
   If (NOT V147) Then
      i := SioTxFlush(V71);
End;

Function V159(Var V55: hdrType): LongInt;
Var
   V60: LongInt;
Begin
   V60 := V55[V190];
   V60 := (V60 SHL 8) OR V55[V189];
   V60 := (V60 SHL 8) OR V55[V188];
   V60 := (V60 SHL 8) OR V55[V187];
   V159 := V60
End;

Procedure V165(V60: LongInt);
Begin
   V107[V187] := BYTE(V60);
   V107[V188] := BYTE(V60 SHR 8);
   V107[V189] := BYTE(V60 SHR 16);
   V107[V190] := BYTE(V60 SHR 24)
End;

Function V161: Integer;
{ Gets a byte by ZMODEM escape coding }
Var
   c, d: Integer;
Begin
   If (NOT V147) Then
   Begin
      V161 := V72;
      Exit
   End;
   c := V155(V79);
   If (c <> V133) Then
   Begin
      V161 := c;
      Exit
   End;
   {got V133 or 1st CAN}
   c := V155(V79);
   If (c = V10) Then
   Begin
      {got 2nd CAN}
      c := V155(V79);
      If (c = V10) Then
      Begin
         {got 3rd CAN}
         c := V155(V79);
         If (c = V10) Then
            {got 4th CAN}
            c := V155(V79);
      End
   End;
   { Flags set in high byte }
   CASE c OF
      V10: V161 := V48; {got 5th CAN}
      V127, V128, V129, V130:
         Begin
           {got a frame end marker}
           V161 := (c OR V53)
         End;
      V195:
         V161 := $007F; {ASCII DEL}
      V196:
         V161 := $00FF  {any parity}
    Else
      Begin
         If (c < 0) Then V161 := c
         Else If ((c And $60) = $40) Then
            V161 := c XOR $40
         Else
            V161 := V136
      End
   End
End;

Function V157: Integer;
{ Get a byte received as two ASCII hex digits }
Var
   c, n: Integer;
Begin
   n := V166;
   If (n < 0) Then
      Begin
         V157 := n;
         Exit
      End;
   n := n - $30;
   If (n > 9) Then n := n - 39;
   If (n And $FFF0 <> 0) Then
      Begin
         V157 := V136;
         Exit
      End;
   c := V166;
   If (c < 0) Then
      Begin
         V157 := c;
         Exit
      End;
   c := c - $30;
   If (c > 9) Then c := c - 39;
   If (c And $FFF0 <> 0) Then
      Begin
         V157 := V136;
         Exit
      End;
   V157 := (n SHL 4) OR c
End;

Function V158(Var V55: hdrType): Integer;
{ Receives a hex header }
Var
   V20 : Word;
   c, n: Integer;
Begin
   c := V157;
   If (c < 0) Then
      Begin
         V158 := c;
         Exit
      End;
   V80 := c;
   V20 := UpdateCrc16(V80,0);
   For n := 0 To 3 Do
      Begin
         c := V157;
         If (c < 0) Then
            Begin
               V158 := c;
               Exit
            End;
         V55[n] := Lo(c);
         V20 := UpdateCrc16(Lo(c),V20)
      End;
   c := V157;
   If (c < 0) Then
      Begin
         V158 := c;
         Exit
      End;
   V20 := UpdateCrc16(Lo(c),V20);
   c := V157;
   If (c < 0) Then
      Begin
         V158 := c;
        Exit
      End;
   V20 := UpdateCrc16(Lo(c),V20);
   If (V20 <> 0) Then
      Begin
         {write('[CRC error]');}{mdm}
         Inc(V32);
         WriteIntMsg('Error(1)=',V32);
         V158 := V136;
         Exit
      End;
   If (V155(1) = 13) Then c := V155(1);
   V158 := V80
End;


Function V153(Var V55: hdrType): Integer;
{ Receives a binary header with 16 bit CRC }
Var
   V20 : Word;
   c, n: Integer;
Begin
   c := V161;
   If (c < 0) Then
   Begin
      V153 := c;
      Exit
   End;
   V80 := c;
   V20 := UpdateCrc16(V80,0);
   For n := 0 To 3 Do
      Begin
         c := V161;
         If (Hi(c) <> 0) Then
            Begin
               V153 := c;
               Exit
            End;
         V55[n] := Lo(c);
         V20 := UpdateCrc16(Lo(c),V20)
      End;
   c := V161;
   If (Hi(c) <> 0) Then
      Begin
         V153 := c;
         Exit
      End;
   V20 := UpdateCrc16(Lo(c),V20);
   c := V161;
   If (Hi(c) <> 0) Then
      Begin
         V153 := c;
         Exit
      End;
   V20 := UpdateCrc16(Lo(c),V20);
   If (V20 <> 0) Then
      Begin
         Inc(V32);
         WriteIntMsg('Error(2)=',V32);
         Exit
      End;
   V153 := V80
End;


Function V154(Var V55: hdrType): Integer;
{ Receives a binary header with 32 bit CRC }
Var
   V20 : LongInt;
   c, n: Integer;
Begin
   c := V161;
   If (c < 0) Then
   Begin
      V154 := c;
      Exit
   End;
   V80 := c;
   V20 := UpdateCrc32(V80,$FFFFFFFF);
   For n := 0 To 3 Do
   Begin
      c := V161;
      If (Hi(c) <> 0) Then
      Begin
         V154 := c;
         Exit
      End;
      V55[n] := Lo(c);
      V20 := UpdateCrc32(Lo(c),V20)
   End;
   For n := 0 To 3 Do
   Begin
      c := V161;
      If (Hi(c) <> 0) Then
      Begin
         V154 := c;
         Exit
      End;
      V20 := UpdateCrc32(Lo(c),V20)
   End;
   If (V20 <> $DEBB20E3) Then
   Begin
      Inc(V32);
      WriteIntMsg('Error(3)=',V32);
      V154 := V136;
      Exit
   End;
   V154 := V80
End;

Function V156(Var V55: hdrType): Integer;
Label
   V47, V2, again2, V89, V25;
Var
   i, c, n : Integer;
   V12: Integer;
Begin
   n := 32;
   V12 := 5;
   V21 := FALSE;
V2:
   If (KeyPressed) Then
      If (ReadKey = chr(V10)) Then
      Begin
         V176;
         WriteMsg('Cancelled by USER');
         V156 := V119;
         Exit
      End;
   V76 := 0;
   V80 := 0;
   {expect to read ZPAD}
   c := V166;
   CASE c OF
      V191:
         ;
      V72, V201:
         goto V25;
      V10:
         Begin
V47:
           Dec(V12);
           If (V12 < 0) Then
           Begin
              c := V119;
              goto V25
           End;
           c := V155(1);
           CASE c OF
              V201:
                 goto V2;
              V130:
                 Begin
                    c := V136;
                    goto V25
                 End;
              V72:
                 goto V25;
              V10:
                 Begin
                    Dec(V12);
                    If (V12 < 0) Then
                    Begin
                       c := V119;
                       goto V25
                    End;
                    goto V2
                 End
              Else
                {fallthru}
           End {case}
         End {can}
   Else {case}
         {char is not V191 !}
again2:    Begin
            Dec(n);
            If (n < 0) Then
               Begin
                  Inc(V32);
                  WriteIntMsg('Header is unrecognizable. Errors=',V32);
                  V156 := V136;
                  Exit
               End;
            If (c <> V10) Then V12 := 5;
            {go back to continue looking for ZPAD}
            goto V2
         End
   End; {case}
   {got ZPAD}
   V12 := 5;
V89:
   c := V166;
   CASE c OF
      V133:
         {this is what we want!} ;
      V191:
         goto V89;   {junk or second '*' of a hex header}
      V72, V201:
         goto V25
      Else
         goto again2
   End; {case}
   {got ZDLE}
   c := V166;
   CASE c OF
      V116:
         Begin
            V76 := V116;
            c := V154(V55);
         End;
      V115:
         Begin
            V76 := V115;
            c := V153(V55);
         End;
      V145:
         Begin
            V76 := V145;
            c := V158(V55);
         End;
      V10:
         goto V47;
      V72, V201:
         goto V25
      Else
         goto again2
   End; {only falls thru if we got V115, V116 or ZHEX}
   V78 := V159(V55);
V25:
   V152('R',c,V55); {mdm}
   V156 := c
End;
{*******************}
{ RECEIVE  ROUTINES }
{*******************}

Var
   {zmBatch : Boolean;}  {mdm}
   TryZhdrType: BYTE;
   V75  : Integer;
   V41: LongInt;
   V57 : Boolean;
   V29  : Boolean;
   V125    : BYTE;

Function V167(Var V8: BufType; V5: Integer): Integer;
{ Get a 32 bit CRC data block }
Label
   V22;
Var
   c, d: Integer;
   n, i: Integer;
   V20 : LongInt;
   V25: Boolean;
Begin
   V21 := TRUE;
   V20 := $FFFFFFFF;
   V75 := 0;
   V25 := FALSE;
   Repeat
      c := V161;
      If (Hi(c) <> 0) Then
      Begin
V22:
         CASE c OF
            V49,V50,V51,V52:
               Begin
                  d := c;
                  V20 := UpdateCrc32(Lo(c),V20);
                  For n := 0 To 3 Do
                  Begin
                     c := V161;
                     If (Hi(c) <> 0) Then goto V22;
                     V20 := UpdateCrc32(Lo(c),V20)
                  End;
                  If (V20 <> $DEBB20E3) Then
                     Begin
                        Inc(V32);
                        WriteIntMsg('Error(4)=',V32);
                        V167 := V136
                     End
                  Else
                     V167 := d;
                  V25 := TRUE
               End;
            V48:
               Begin
                  V167 := V119;
                  V25 := TRUE
               End;
            V201:
               Begin
                  V167 := c;
                  V25 := TRUE
               End;
            V72:
               Begin
                  V167 := c;
                  V25 := TRUE
               End
            Else
               Begin
                  WriteMsg('Garbage...');
                  i := SioRxFlush(V71);
                  V167 := c;
                  V25 := TRUE
               End
         End {case}
      End;
      If (NOT V25) Then
      Begin
         Dec(V5);
         If (V5 < 0) Then
         Begin
            WriteMsg('Long packet');
            V167 := V136;
            V25 := TRUE
         End;
         V8[Integer(V75)] := Lo(c);
         Inc(V75);
         V20 := UpdateCrc32(Lo(c),V20)
      End
   Until V25
End;

Function V170(Var V8: BufType; V5: Integer): Integer;
{ get a 16 bit CRC data block }
Label
   V22;
Var
   i, c, d: Integer;
   V20 : Word;
   V25: Boolean;
Begin
   If (V76 = V116) Then
      Begin
         {WriteLn('CRC32');}
         V170 := V167(V8,V5);
         Exit
      End;
   {WriteLn('CRC16');}
   V20 := 0;
   V75 := 0;
   V25 := FALSE;
   Repeat
      c := V161;
      If (Hi(c) <> 0) Then
      Begin
V22:  CASE c OF
            V49,V50,V51,V52:
               Begin
                  d := c;
                  V20 := UpdateCrc16(Lo(c),V20);
                  c := V161;
                  If (Hi(c) <> 0) Then goto V22;
                  V20 := UpdateCrc16(Lo(c),V20);
                  c := V161;
                  If (Hi(c) <> 0) Then goto V22;
                  V20 := UpdateCrc16(Lo(c),V20);
                  If (V20 <> 0) Then
                     Begin
                        Inc(V32);
                        WriteIntMsg('Error(5)=',V32);
                        V170 := V136;
                        V25 := TRUE
                     End;
                  V170 := d;
                  V25 := TRUE
               End;
            V48:
               Begin
                  WriteMsg('Received CAN');
                  V170 := V119;
                  V25 := TRUE
               End;
            V201:
               Begin
                  V170 := c;
                  V25 := TRUE
               End;
            V72:
               Begin
                  WriteMsg('Lost carrier');
                  V170 := c;
                  V25 := TRUE
               End
            Else
               Begin
                  WriteMsg('Garbage...');
                  i := SioRxFlush(V71);
                  V170 := c;
                  V25 := TRUE
               End
         End {case}
      End;
      If (NOT V25) Then
      Begin
         Dec(V5);
         If (V5 < 0) Then
         Begin
            WriteMsg('Long packet');
            V170 := V136;
            V25 := TRUE
         End;
         V8[Integer(V75)] := Lo(c);
         Inc(V75);
         V20 := UpdateCrc16(Lo(c),V20)
      End
   Until V25
End;

Procedure V81;
{ Acknowledge request to terminate cleanly }
Var
   n, i: Integer;
Begin
   V165(V78);
   n := 4;
   i := SioRxFlush(V71);
   Repeat
      V182(V143,V107);
      CASE V155(V105) OF
         V201, V72:
            Exit;
         79:
            Begin
                If V155(ONE_SECOND) = 79 Then
                   {null};
                i := SioRxFlush(V71);
                Exit
            End
         Else
            i := SioRxFlush(V71);
            Dec(n)
      End {case}
   Until (n <= 0)
End;

Function V83: Integer;
Label
   V2;
Var
   c, n  : Integer;
   V33: Integer;
   V43  : Byte;
Begin
   FillChar(V4,V114,0);
   V32 := 0;
   V33 := 0;
   For n := 10 DownTo 0 Do
   Begin
      If (NOT V147) Then
      Begin
         WriteMsg('Lost carrier');
         V83 := V136;
         Exit
      End;
      V165(LongInt(0));
      V43 := V15 OR V17 OR V14 OR V11;
      V107[V137] := V43;
      V182(TryZhdrType,V107);
      If (TryZhdrType = V198) Then TryZhdrType := V192;
V2:
      c := V156(V77);
      CASE c OF
         V142:
            Begin
               V125 := V77[V137];
               TryZhdrType := V192;
               c := V170(V85,V117);
               If (c = V52) Then
                  Begin
                     V83 := V142;
                     Exit
                  End;
               V182(V185,V107);
               goto V2
            End;
         V197:
            Begin
               c := V170(V4,V117);
               If (c = V52)
                  Then V182(V113,V107)
                  Else V182(V185,V107);
               goto V2
            End;
         V144:
            Begin
               V165(DiskFree(0));
               V182(V113,V107);
               goto V2
            End;
         V123:
            Begin
               c := V170(V85,V117);
               If (c = V52) Then
               Begin
                  V165(LongInt(0));
                  Repeat
                     V182(V124,V107);
                     Inc(V33)
                  Until (V33 > 10) OR (V156(V77) = V143);
                  V81;
                  V83 := V124;
                  Exit
               End;
               V182(V185,V107);
               goto V2
            End;
         V124, V143:
            Begin
               V83 := V124;
               Exit
            End;
         V119, V72:
            Begin
               V83 := c;
               Exit
           End
      End {case}
   End; {for}
   WriteMsg('Timed out');
   V83 := V136
End;

Function V82: Integer;
Var
   e, p, n, i: Integer;
   V101 : String;
   V100   : LongInt;
   V23   : SearchRec;
Begin
   V57 := TRUE;
   V38 := LongInt(0);
   p := 0;
   V101 := '';
   While (p < 255) And (V85[p] <> 0) Do
   Begin
      V101 := V101 + UpCase(Chr(V85[p]));
      Inc(p)
   End;
   Inc(p);
   { get rid of drive & path specifiers }
   While (Pos(':',V101) > 0) Do Delete(V101,1,Pos(':',V101));
   While (Pos('\',V101) > 0) Do Delete(V101,1,Pos('\',V101));
   V39 := V101;
   { name completed }
   V38 := LongInt(0);
   While (p < V117) And (V85[p] <> $20) And (V85[p] <> 0) Do
   Begin
      V38 := (V38 *10) + Ord(V85[p]) - $30;
      Inc(p)
   End;
   Inc(p);
   { size completed }
   V101 := '';
   While (p < V117) And (V85[p] IN [$30..$37]) Do
      Begin
         V101 := V101 + Chr(V85[p]);
         Inc(p)
      End;
   Inc(p);
   V42 := Z2DosDate(V101);
   { time completed }
   {$I-}
   FindFirst(V39,Archive,V23);
   {$I+}
   If (DosError = 0) AND (IOresult = 0) Then
      Begin
         { file already exists }
         V100 := V23.Size;
         If (V125 = V131) And (V38 > V100) Then
            Begin
               V41 := V100;
               If not fioOpen(V39) Then
                  Begin
                     WriteMsg('Error opening '+V39);
                     V82 := V136;
                     Exit
                  End;
               If not fioSeek(V100) Then
                  Begin
                     WriteMsg('Error positioning file');
                     V82 := V136;
                     Exit
                  End;
               WriteMsg('Recovering')
            End
         Else
            Begin
               WriteMsg(V39+' is already complete');
               V82 := V198;
               Exit
            End
      End
   Else
      Begin
         V41 := 0;
         If not fioCreate(V39) Then
            Begin
               WriteMsg('Unable to create '+V39);
               V82 := V136;
               Exit
            End
      End;
   WriteLongMsg('Size=',V38);
   V82 := V186
End;

Function V84(Var V74: LongInt): Integer;
Begin
   If (KeyPressed) Then
      If (ReadKey = chr(V10)) Then
         Begin
            WriteMsg('Aborted by USER');
            V176;
            V84 := V136;
            Exit
         End;
   If not fioWrite(V85,V75) Then
      Begin
         V24;
         V84 := V136
      End
   Else V84 := V186;
   V74 := V74 + V75
End;

Function V171: Integer;
Label
   V31, V67, V62;
Var
   c, n   : Integer;
   V74: LongInt;
   V25   : Boolean;
Begin
   V32 := 0;
   V25 := FALSE;
   V29 := FALSE;
   c := V82;
   If (c <> V186) Then
   Begin
      If (c = V198) Then TryZhdrType := V198;
      V171 := c;
      Exit
   End;
   c := V186;
   n := 10;
   V74 := V41;
   V78 := V41;
   Repeat
      V165(V74);
      V182(V193,V107);
V67:
      c := V156(V77);
      CASE c OF
         V132:
            Begin
               If (V78 <> V74) Then
                  Begin
                      Dec(n);
                      Inc(V32);
                      WriteIntMsg('Error(6)=',V32);
                      If (n < 0) Then goto V31;
                      WriteMsg('Bad position');
                      zmPutString(V4)
                  End
               Else
                  Begin
V62:
                      c := V170(V85,V117);
                      CASE c OF
                         V119, V72:
                            goto V31;
                         V136:
                            Begin
                               Dec(n);
                               Inc(V32);
                               WriteIntMsg('Error',V32);
                               If (n < 0) Then goto V31;
                               zmPutString(V4)
                            End;
                         V201:
                            Begin
                                Dec(n);
                                If (n < 0) Then goto V31
                            End;
                         V52:
                            Begin
                                 n := 10;
                                 c := V84(V74);
                                 If (c <> V186) Then
                                    Begin
                                       V171 := c;
                                       Exit
                                    End;
                                 WriteLongMsg('ZCRCW: Pos=',V74);
                                 V165(V74);
                                 V182(V113,V107);
                                 goto V67
                             End;
                          V51:
                             Begin
                                n := 10;
                                c := V84(V74);
                                If (c <> V186) Then
                                   Begin
                                      V171 := c;
                                      Exit
                                    End;
                                WriteLongMsg('ZCRCQ: Pos=',V74);
                                V165(V74);
                                V182(V113,V107);
                                goto V62
                             End;
                          V50:
                             Begin
                                n := 10;
                                c := V84(V74);
                                If (c <> V186) Then
                                   Begin
                                      V171 := c;
                                      Exit
                                   End;
                                WriteLongMsg('ZCRCG: Pos=',V74);
                                goto V62
                             End;
                         V49:
                             Begin
                                n := 10;
                                c := V84(V74);
                                If (c <> V186) Then
                                   Begin
                                      V171 := c;
                                      Exit
                                   End;
                                WriteLongMsg('ZCRCE: Pos=',V74);
                                goto V67
                             End
                      End {case}
                   End
                End; {case of ZDATA}
         V185, V201:
            Begin
               Dec(n);
               If (n < 0) Then goto V31;
               WriteLongMsg('Pos=',V74)
            End;
         V142:
            Begin
               c := V170(V85,V117);
            End;
         V135:
            If (V78 = V74) Then
               Begin
                  V171 := c;
                  Exit
               End
            Else goto V67;
         V136:
            Begin
               Dec(n);
               If (n < 0) Then goto V31;
               WriteLongMsg('Pos=',V74);
               zmPutSTring(V4)
            End
      Else {case}
         Begin
            c := V136;
            goto V31
         End
      End {case}
   Until (NOT V25);
V31:
   V171 := V136
End;

Function V169: Integer;
Var
   c    : Integer;
   V103 : LongInt;
Begin
   WriteMsg('Receiving');
   While (True) Do
      Begin
         If NOT (V147) Then
            Begin
            V169 := V136;
            Exit
         End;
         V103 := SioTimer;
         c := V171;
         fioSetFTime(V42);
         WriteCPS(V103,V38,V39,(c=V198));
         fioClose;
         CASE c OF
            V135,V198:
               Begin
                  c := V83;
                  CASE c OF
                     V142:
                        {null};
                     V124:
                        Begin
                           V81;
                           V169 := V186;
                           Exit
                        End;
                  Else {case}
                     Begin
                        V169 := V136;
                        Exit
                     End
                  End {case}
            End {begin}
         Else {case}
            Begin
               V169 := c;
               Exit
            End
         End {case}
      End {while}
End;


Function V168(V70: Integer): Boolean;
Var
   i: Integer;
Begin
   V71 := V70;
   WriteIntMsg('zmReceive: V71=',V71);
   V79 := V96;
   TryZhdrType := V192;
   i := V83;
   If (i = V124) OR ((i = V142) And ((V169) = V186)) Then
      Begin
         WriteMsg('Done.');
         V168 := TRUE
      End
   Else
      Begin
         i := SioTxFlush(V71);
         WriteMsg('Sending CAN');
         V176;
         WriteMsg('Done.');
         V168 := FALSE;
      End
End;

{ Send ROUTINES }

Var
   V90   : LongInt;
   V106   : BufType;
   V73: Integer;
   {BlocksRead: Integer;}

Procedure V173(hType: BYTE; Var V55: hdrType);
Var
   V20 : LongInt;
   i, n: Integer;
Begin
   V152('S',hType,V55); {mdm}
   i := SioPutc(V71,chr(V191));
   i := SioPutc(V71,chr(V133));
   i := SioPutc(V71,chr(V116));
   V175(hType);
   V20 := UpdateCrc32(hType,$FFFFFFFF);
   For n := 0 To 3 Do
      Begin
         V175(V55[n]);
         V20 := UpdateCrc32(V55[n],V20)
      End;
   V20 := (NOT V20);
   For n := 0 To 3 Do
      Begin
         V175(BYTE(V20));
         V20 := (V20 SHR 8)
      End;
   If (hType <> V132) Then SioDelay(V95)
End;

Procedure V174(hType: BYTE; Var V55: hdrType);
Var
   V20 : Word;
   i, n: Integer;
Begin
   If (V21) Then
      Begin
         V173(hType,V55);
         Exit
      End;
   V152('S',hType,V55); {mdm}
   i := SioPutc(V71,chr(V191));
   i := SioPutc(V71,chr(V133));
   i := SioPutc(V71,chr(V115));
   V175(hType);
   V20 := UpdateCrc16(hType,0);
   For n := 0 To 3 Do
      Begin
         V175(V55[n]);
         V20 := UpdateCrc16(V55[n],V20)
      End;
   V20 := UpdateCrc16(0,V20);
   V20 := UpdateCrc16(0,V20);
   V175(Lo(V20 SHR 8));
   V175(Lo(V20));
   If (hType <> V132) Then SioDelay(V95)
End;

Procedure V177(Var V8: BufType; V5: Integer; V44: BYTE);
Var
   V20 : LongInt;
   i   : Integer;
Begin
   {send the data}
   V20 := $FFFFFFFF;
   For i := 0 To (V5 - 1) Do
      Begin
         V175(V8[i]);
         V20 := UpdateCrc32(V8[i],V20)
      End;
   {send Frame End & CRC}
   V20 := UpdateCrc32(V44,V20);
   V20 := (NOT V20);
   i := SioPutc(V71,chr(V133));
   i := SioPutc(V71,chr(V44));
   For i := 0 To 3 Do
      Begin
         V175(BYTE(V20));
         V20 := (V20 SHR 8)
      End;
   Begin
      i := SioPutc(V71,chr(17));
      {SioDelay(V95)}
   End
End;

Procedure V178(Var V8: BufType; V5: Integer; V44: BYTE);
Var
   V20 : Word;
   i, t: Integer;
Begin
   If (V21) Then
      Begin
         V177(V8,V5,V44);
         Exit
      End;
   {send the data}
   V20 := 0;
   For t := 0 To (V5 - 1) Do
      Begin
         V175(V8[t]);
         V20 := UpdateCrc16(V8[t],V20)
      End;
   {send Frame End & CRC}
   V20 := UpdateCrc16(V44,V20);
   i := SioPutc(V71,chr(V133));
   i := SioPutc(V71,chr(V44));
   V20 := UpdateCrc16(0,V20);
   V20 := UpdateCrc16(0,V20);
   V175(Lo(V20 SHR 8));
   V175(Lo(V20));
   If (V44 = V130) Then
      Begin
         i := SioPutc(V71,chr(17));
         {SioDelay(V95)}
      End
End;

Procedure V179;
Var
   i   : Integer;
   V25: Boolean;
Begin
   V25 := FALSE;
   Repeat
      V165(V108);
      V174(V143,V107);
      CASE V156(V77) OF
         V143:
            Begin
               i := SioPutc(V71,'O');
               i := SioPutc(V71,'O');
               SioDelay(V54);
               i := SioTxFlush(V71);
               Exit
            End;
         V119, V72, V141, V201:
            Exit
      End {case}
   Until (V25)
End;

Function V160: Integer;
Var
   n, c: Integer;
Begin
   WriteMsg('Getting info.');
   For n := 1 To 10 Do
      Begin
         c := V156(V77);
         CASE c OF
            V121:
               Begin
                  V165(V78);
                  V182(V113,V107)
               End;
            V123:
               Begin
                  V165(LongInt(0));
                  V182(V194,V107)
               End;
            V192:
               Begin
                  V73 := (Word(V77[V188]) SHL 8) OR V77[V187];
                  V21 := ((V77[V137] And V14) <> 0);
                  {if V21 then WriteLn('CRC32') else WriteLn('CRC16');}
                  V160 := V186;
                  Exit
               End;
            V119,V72,V201:
               Begin
                  V160 := V136;
                  Exit
               End
      Else {case}
         If (c <> V194) OR (V77[V137] <> V123) Then
            V182(V185,V107)
      End {case}
   End; {for}
   V160 := V136
End;

Function V184: Integer;
Var
   i, c     : Integer;
   V64: Integer;
Begin
   V64 := 7;
   Repeat
      c := V156(V77);
      i := SioRxFlush(V71);
      CASE c OF
         V201:
            Begin
               Dec(V64);
               If (V64 < 0) Then
                  Begin
                     V184 := V136;
                     Exit
                  End
            End;
         V119, V112, V143, V72:
            Begin
               V184 := V136;
               Exit
            End;
         V193:
            Begin
               If not fioSeek(V78) Then
                  Begin
                     WriteMsg('File seek error');
                     V184 := V136;
                     Exit
                  End;
               WriteMsg('Repositioning...');
               WriteLongMsg('Pos=',V78);
               V108 := V78;
               V184 := c;
               Exit
            End;
         V198, V192, V113:
            Begin
               V184 := c;
               Exit
            End
      Else {case}
         Begin
            WriteMsg('Unspecified error!');
            V174(V185,V107)
         End
      End {case}
   Until (False)
End;


Function V181: Integer;
Label
   V109, V88, V69;
Var
   i, c       : Integer;
   V44   : Integer;
   V65   : Word;
   V6: Word;
   V9  : Word;
   V61: Word;
   V45 : Word;
   V46 : Word;
Begin
   WriteMsg('Sending file');
   V46 := 1;
   V61 := V117;
   V6 := V61;
V88:
   If SioRxQue(V71) = 0 Then
      Begin
V109:
         c := V184;
         CASE c OF
            V198:
               Begin
                  V181 := V198;
                  Exit
               End;
            V113:
               {null};
            V193:
               Begin
                  Inc(V32);
                  WriteIntMsg('Error(7)=',V32);
                  If ((V6 SHR 2) > 32) Then
                     V6 := (V6 SHR 2)
                  Else
                     V6 := 32;
                  V45 := 0;
                  V46 := (V46 SHL 1) OR 1
               End;
            V192:
               Begin
                  V181 := V186;
                  Exit
               End
         Else {case}
            Begin
               V181 := V136;
               Exit
            End
         End {case};
      While (SioRxQue(V71) > 0) Do
         Begin
            CASE (V155(1)) OF
               V10, V191:
                  goto V109;
               V72:
                  Begin
                     V181 := V136;
                     Exit
                  End
            End {case}
         End
   End; {if char avail}
   V65 := V73;
   V165(V108);
   V174(V132,V107);
   Repeat
      If (KeyPressed) Then
         If (ReadKey = chr(V10)) Then
            Begin
               WriteMsg('Aborted by USER');
               V176;
               goto V69
            End;
      If (NOT V147) Then goto V69;
      if not fioRead(V106,V6,V9) then
         Begin
            V24;
            V176;
            goto V69
         End;

      If (V9 < V6) Then V44 := V127
      Else
         If (V73 <> 0) And (V65 <= V9) Then
            Begin
               V65 := V65 - V9;
               V44 := V130;
            End
         Else
            Begin
               if V92 then V44 := V128
               else V44 := V130;
            End;

      V178(V106,V9,V44);
      V108 := V108 + V9;
      V26[5] := V27[V44-104];
      WriteLongMsg(V26,V108);
      Inc(V45);
      If (V6 < V61) And (V45 > V46) Then
         Begin
            If ((V6 SHL 1) < V61) Then
               V6 := (V6 SHL 1)
            Else
               V6 := V61;
            V45 := 0
         End;
      If V44 = V130 Then goto V109;
      While SioRxQue(V71) > 0 Do
         Begin
            CASE V155(1) OF
               V10, V191:
                  Begin
                     WriteMsg('Trouble?');
                     i := SioTxFlush(V71);
                     V178(V106,0,V127);
                     goto V109
                  End;
               V72:
                  Begin
                     V181 := V136;
                     Exit
                  End
            End {case}
         End {while}
   Until (V44 <> V128);
   Repeat
      V165(V108);
      WriteMsg('Sending EOF');
      V174(V135,V107);
  SioDelay(5); {!!!}
      c := V184;
      CASE c OF
         V113:
            {null};
         V193:
            goto V88;
         V192:
            Begin
               V181 := V186;
               Exit
            End;
         V198:
            Begin
               V181 := c;
               Exit
            End
      Else {case}
V69:    Begin
            V181 := V136;
            Exit
         End
      End {case}
   Until (c <> V113)
End;

Function V180: Integer;
Var
   c   : Integer;
Begin
   V32 := Word(0);
   Repeat
      If KeyPressed Then
         If (ReadKey = chr(V10)) Then
            Begin
               V176;
               WriteMsg('Aborted from keyboard');
               V180 := V136;
               Exit
            End;
      If (NOT V147) Then
         Begin
            WriteMsg('Lost carrier');
            V180 := V136;
            Exit
         End;
      FillChar(V107,4,0);
      V107[V137] := V131; {recover}
      V174(V142,V107);
      V178(V106,V117,V130);
      Repeat
         c := V156(V77);
         CASE c OF
            V119, V72, V201, V143, V112:
               Begin
                  V180 := V136;
                  Exit
               End;
            V192:
               {null - this will cause a loopback};
            V126:
               Begin
                  V165(V151);
                  V182(V126,V107)
               End;
            V198:
               Begin
                 V180 := c;
                 Exit
               End;
            V193:
               Begin
                 If not fioSeek(V78) Then
                     Begin
                        WriteMsg('File positioning error');
                        V182(V141,V107);
                        V180 := V136;
                        Exit
                     End;
                  WriteLongMsg('Setting start position =',V78);
                  V90 := V78;
                  V108 := V78;
                  V180 := V181;
                  Exit
                End
         End {case}
      Until (c <> V192)
   Until (False)
End;

Function V172(V70: Integer; TheFile: String; LastFile: Boolean): Boolean;
Var
   i, n     : Integer;
   V101: String;
   V23  : SearchRec;
   V103     : LongInt;
Begin
   V32 := 0;
   V71 := V70;
   If (NOT V147) Then
      Begin
         WriteMsg('Lost carrier');
         SioDelay(V105);
         V172 := FALSE;
         Exit
      End;
   {$I-}
   FindFirst(TheFile,Archive,V23);
   {$I+}
   If (DosError <> 0) OR (IOresult <> 0) Then
      Begin
         WriteMsg('Unable to open '+TheFile);
         V179;
         V172 := FALSE;
         Exit
      End
   else
      Begin
         V39 := V23.Name;
         V38 := V23.Size;
         V42 := V23.Time;
      End;
   WriteLongMsg('Filesize=',V38);
   Str(V38,V101);
   V101 := (V39 + #0 + V101 + ' ');
   V101 := V101 + Dos2Zdate(V42);
   n := Length(V101);
   For n := 1 To Length(V101) Do
      Begin
         If (V101[n] IN ['A'..'Z']) Then
            V101[n] := Chr(Ord(V101[n]) + $20)
      End;
   FillChar(V106,V117,0);
   Move(V101[1],V106[0],Length(V101));
   V79 := V96;
   V4[0] := Ord('r');
   V4[1] := Ord('z');
   V4[3] := 13;
   V4[4] := 0;

   zmPutString(V4);
   FillChar(V4,V114,0);
   V165(LongInt(0));
   V182(V194,V107);
   If V160 = V136 Then
      Begin
         V172 := FALSE;
         Exit
      End;
   If not fioOpen(V39) Then
      Begin
         WriteMsg('Cannot open '+V39);
         V176;
         V172 := FALSE;
         Exit
      End;
   { send the file }
   V103 := SioTimer;
   n := V180;
   WriteCPS(V103,V38,V39,(n=V198));
   fioClose;
   If IOresult <> 0 Then {ignore result};
   If LastFile Then V179;
   V172 := TRUE
   End;

function ZmodemTx(
         V70     : Integer;      { COM port }
     Var V40 : String;       { File spec buffer }
         V91   : Boolean)      { Can do streaming ? }
       : Boolean;
var
  V23  : SearchRec;
  V102 : String;
  V66 : String;
  V58 : Boolean;
begin
  V92 := V91;
  ZmodemTx := False;
  V58 := False;
  { fetch filespec if not already specified }
  if not FetchName(V40) then exit;
  { find first filename }
  FindFirst(V40,AnyFile,V23);
  if DosError = 0 then V102 := V23.Name
  else begin
    WriteMsg('Cannot open '+V40);
    exit
  end;
  { send each file in turn }
  repeat
      FindNext(V23);
      if DosError = 0 then V66 := V23.Name
      else V58 := True;
      ZmodemTx := V172(V70,V102,V58);
      V102 := V66;
  until V58;
  WriteMsg('ZMODEM completed');
end; {ZmodemTx}

function ZmodemRx(
         V70     : Integer;      { COM port }
     Var V39 : String;       { filename buffer }
         V91   : Boolean)      { Can do streaming ? }
       : Boolean;
begin
  V92 := V91;
  ZmodemRx := V168(V70);
  WriteMsg('ZMODEM completed');
end; {ZmodemRx}


End. {ZMODEM}